TBA
library(xlsx)
library(DT)
library(knitr)
library(dplyr)
library(tidyr)
library(janitor)
library(imputeTS)
library(lares)
library(plotly)
library(caret)
library(qgraph)
library(ggforce)
raw_data <- read.xlsx(filename, 1)
raw_data <- as_tibble(raw_data)
dim(raw_data)
## [1] 6120 81
Pierwsze 500 wierszy ze zbioru:
Podstawowe statystyki dla calego zbioru:
Podstawowe statystyki dla poszczegolnych atrybutow:
Wstepne czyszczenie danych:
#raw_data[raw_data==-1]<-NA
#filling PATIENT_ID
id_filled <- raw_data %>% fill(PATIENT_ID)
#remove rows where all variables are empty
vars <- colnames(id_filled)[-(1:7)]
no_empty_rows<- id_filled[rowSums(is.na(id_filled[vars])) != length(vars), ]
no_empty_cols <- no_empty_rows[colSums(!is.na(no_empty_rows)) > 0]
#renaming columns
colnames_cleaned <- no_empty_cols %>% clean_names()
Eliminacja brakujących wartości na poziomie pacjenta obejmowała:
Jeżeli żadne z powyższych rozwiązań nie było możliwe, wartości NA zostawiono.
clean_NA<-function(column){
not_NA_count<-sum(!is.na(column))
if (not_NA_count>=2){ #interpolate
column <- na_interpolation(column, option = "linear")
column
}
else if (not_NA_count==1){ #constant value
val <- first(na.omit(column))
column[is.na(column)] <- val
column
}#default: leave NA values
column
}
#for each patient:
# for each column:
# clean_NA
cleaned<- colnames_cleaned%>% group_by(patient_id) %>% mutate_each(list(clean_NA))
#extract columns with attributes only
attributes<-cleaned[-(1:7)]
Podsumowanie zbioru:
| Parametr | Wartosc |
|---|---|
| Liczba pacjentów | 360 |
| Liczba pomiarów | 6106 |
| Srednia liczba pomiarów na pacjenta | 17 |
| K | 212 |
| M | 149 |
| Smierc | 195 |
| Wypisanie ze szpitala | 166 |
| Liczba wierszy | 81 |
| Liczba zmiennych | 74 |
| Procent brakujacych wartosci | 7 |
Wykresy prezentujące podział danych ze względu na płeć i wynik:
Wykres obrazujący czasy przyjęcia i wypisania lub śmierci z wyróżnieniem płci:
***Tabela pokazująca 30 pierwszych rekordow po wyczyszczeniu danych:
Podsumowanie każdego z atrybutów:
Histogramy przedstawiajace rozklad atrybutow:
Poniższy graf przedstawia korelację pomiędzy parami atrybutów. Grubość lini łączącej dwa atrybuty jest zależna od współczynnika korelacji, natomiast kolor oznacza korelację dodatnią (kolor zielony) lub ujemną (kolor czerwony)
Wykres przedstawiający 20 par atrybutów z największą korelacją:
Interaktywny wykres lub animację prezentującą zmianę wybranych atrybutów w czasie.
to wywalic:
timeline_plot <- ggplot() +
coord_cartesian() +
scale_color_hue() +
layer(data=cleaned,
mapping=aes(
x=re_date,
y=hypersensitive_cardiac_troponin_i, group=patient_id
),
stat="identity",
geom="point",
position=
position_jitter()
)
ggplotly(timeline_plot)
to wywalic:
timeline_plot <- ggplot(cleaned, aes(x=re_date, y=serum_chloride, colour=factor(patient_id), group=patient_id)) + geom_line() + geom_point() + facet_wrap(~outcome)
ggplotly(timeline_plot)
Poniższy wykres przedstawia średnie wartości atrybutów hemoglobin (poziom hemoglobiny we krwi) oraz glucose (poziom glukozy we krwi) dla poszczególnych dni pobytu pacjenta w szpitalu. Celem wykresu jest próba pokazania zmiany tych atrybutów w czasie hospitalizacji, czyli z założenia najcięższego przebiegu choroby.
## `summarise()` regrouping output by 'id' (override with `.groups` argument)
## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.
## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.
## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.
## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.
klasyfikator przewidujący czy dany pacjent przeżyje (w tej sekcji należy wykorzystać wiedzę z pozostałych punktów oraz wykonać dodatkowe czynności, które mogą poprawić trafność predykcji); dobór parametrów modelu oraz oszacowanie jego skuteczności powinny zostać wykonane za pomocą techniki podziału zbioru na dane uczące, walidujące i testowe; trafność klasyfikacji powinna zostać oszacowana na podstawie kliku wybranych (i uzasadnionych) miar oceny klasyfikacji.
ml_data<- cleaned%>%group_by(patient_id)%>%summarise_all(funs(last))
ml_data<-na_mean(ml_data) #TO ZROBIC OSOBNO DLA ZBIORU TESTUJACEGO I UCZACEGO!
#rozwazyc: usuniecie tych kolumn (wierszy), w których jest dużo wartosci NA (np. powyżej 40%?)
#ml_data$outcome=as.factor(ml_data$outcome)
ml_data$outcome=factor(ml_data$outcome,
labels = make.names(c("negative", "positive")))
inTraining <-
createDataPartition(
# atrybut do stratyfikacji
y = ml_data$outcome,
# procent w zbiorze uczącym
p = .75,
# chcemy indeksy a nie listę
list = FALSE)
training <- ml_data[ inTraining,]
testing <- ml_data[ -inTraining,]
ctrl <- trainControl(
method = "repeatedcv",
number = 2,
repeats = 5)
fit <- train(outcome ~ .,
data = training,
method = "rf",
trControl = ctrl,
ntree = 10)
rfClasses <- predict(fit, newdata = testing)
confusionMatrix(data = rfClasses, testing$outcome)
ml_data$outcome=factor(ml_data$outcome,
labels = make.names(levels(ml_data$outcome)))
rfGrid <- expand.grid(mtry = 10:30)
gridCtrl <- trainControl(
method = "repeatedcv",
summaryFunction = twoClassSummary,
classProbs = TRUE,
number = 2,
repeats = 5)
fitTune <- train(outcome ~ .,
data = training,
method = "rf",
metric = "ROC",
preProc = c("center", "scale"),
trControl = gridCtrl,
tuneGrid = rfGrid,
ntree = 30)
rfTuneClasses <- predict(fitTune,
newdata = testing)
confusionMatrix(data = rfTuneClasses,
testing$outcome)
ggplot(fitTune) + theme_bw()
analiza typowa dla danych klinicznych, np.: